home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d12 / v10n15.arc / POWER.PAS < prev    next >
Pascal/Delphi Source File  |  1991-08-09  |  2KB  |  67 lines
  1. {$N+,E+}
  2. PROGRAM Power;
  3. CONST epsilon = 1E-4900;
  4.  
  5.   FUNCTION Pow(Base, Expo : Extended;
  6.                VAR error  : Boolean) : Extended;
  7.  
  8.     FUNCTION IsInt(num : Extended) : Boolean;
  9.     BEGIN
  10.       IsInt := ((Abs(Frac(num)) < epsilon) OR
  11.                 (1.0 - Abs(Frac(num)) < epsilon)) AND
  12.                 (Abs(num) < MaxLongInt);
  13.     END;
  14.  
  15.     FUNCTION SignFix(num : LongInt) : ShortInt;
  16.     BEGIN
  17.       IF odd(num) THEN SignFix := -1
  18.       ELSE SignFix := 1;
  19.     END;
  20.  
  21.   BEGIN
  22.     Error := FALSE;
  23.     IF Abs(Base) < epsilon THEN {BASE = 0}
  24.       BEGIN
  25.         Pow := 0;
  26.         Exit;
  27.       END;
  28.  
  29.     IF Abs(Expo) < epsilon THEN {EXPO = 0}
  30.       BEGIN
  31.         Pow := 1;
  32.         Exit;
  33.       END;
  34.  
  35.     IF Base > 0 THEN            {BASE positive}
  36.       Pow := Exp(expo * ln(base))
  37.     ELSE
  38.       BEGIN                     {BASE negative}
  39.         IF IsInt(Expo) THEN     {EXPO integer}
  40.           BEGIN
  41.             Pow := Exp(expo * ln(-base)) *
  42.                       SignFix(round(Expo))
  43.           END
  44.         ELSE
  45.           BEGIN                 {EXPO non-integer}
  46.             Error := TRUE;
  47.             Pow := 0;
  48.           END;
  49.       END;
  50.   END;
  51.  
  52. VAR
  53.   B, E, R : Extended;
  54.   Err : Boolean;
  55. CONST
  56.   isErr : ARRAY[boolean] OF String[7] =
  57.             ('OK     ','*ERROR*');
  58. BEGIN
  59.   WriteLn('Enter 0 for both operands to quit.');
  60.   REPEAT
  61.     Write('Base:'); ReadLn(B);
  62.     Write('Expo:'); ReadLn(E);
  63.     R := Pow(B, E, Err);
  64.     WriteLn(IsErr[Err],'  ',R:30:10);
  65.   UNTIL (B = 0) AND (E = 0);
  66. END.
  67.